home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / perl5.005.tar.gz / perl5.005.tar / perl5.005 / t / op / magic.t < prev    next >
Text File  |  1998-07-14  |  4KB  |  204 lines
  1. #!./perl
  2.  
  3. BEGIN {
  4.     $^W = 1;
  5.     $| = 1;
  6.     chdir 't' if -d 't';
  7.     @INC = '../lib';
  8.     $SIG{__WARN__} = sub { die "Dying on warning: ", @_ };
  9. }
  10.  
  11. sub ok {
  12.     my ($n, $result, $info) = @_;
  13.     if ($result) {
  14.     print "ok $n\n";
  15.     }
  16.     else {
  17.         print "not ok $n\n";
  18.     print "# $info\n" if $info;
  19.     }
  20. }
  21.  
  22. $Is_MSWin32 = $^O eq 'MSWin32';
  23. $Is_VMS     = $^O eq 'VMS';
  24. $Is_Dos   = $^O eq 'dos';
  25. $PERL = ($Is_MSWin32 ? '.\perl' : './perl');
  26.  
  27. print "1..35\n";
  28.  
  29. eval '$ENV{"FOO"} = "hi there";';    # check that ENV is inited inside eval
  30. if ($Is_MSWin32) { ok 1, `cmd /x /c set FOO` eq "FOO=hi there\n"; }
  31. else             { ok 1, `echo \$FOO` eq "hi there\n"; }
  32.  
  33. unlink 'ajslkdfpqjsjfk';
  34. $! = 0;
  35. open(FOO,'ajslkdfpqjsjfk');
  36. ok 2, $!, $!;
  37. close FOO; # just mention it, squelch used-only-once
  38.  
  39. if ($Is_MSWin32 || $Is_Dos) {
  40.     ok "3 # skipped",1;
  41.     ok "4 # skipped",1;
  42. }
  43. else {
  44.   # the next tests are embedded inside system simply because sh spits out
  45.   # a newline onto stderr when a child process kills itself with SIGINT.
  46.   system './perl', '-e', <<'END';
  47.  
  48.     $| = 1;        # command buffering
  49.  
  50.     $SIG{"INT"} = "ok3";     kill "INT",$$; sleep 1;
  51.     $SIG{"INT"} = "IGNORE";  kill "INT",$$; sleep 1; print "ok 4\n";
  52.     $SIG{"INT"} = "DEFAULT"; kill "INT",$$; sleep 1; print "not ok\n";
  53.  
  54.     sub ok3 {
  55.     if (($x = pop(@_)) eq "INT") {
  56.         print "ok 3\n";
  57.     }
  58.     else {
  59.         print "not ok 3 ($x @_)\n";
  60.     }
  61.     }
  62.  
  63. END
  64. }
  65.  
  66. # can we slice ENV?
  67. @val1 = @ENV{keys(%ENV)};
  68. @val2 = values(%ENV);
  69. ok 5, join(':',@val1) eq join(':',@val2);
  70. ok 6, @val1 > 1;
  71.  
  72. # regex vars
  73. 'foobarbaz' =~ /b(a)r/;
  74. ok 7, $` eq 'foo', $`;
  75. ok 8, $& eq 'bar', $&;
  76. ok 9, $' eq 'baz', $';
  77. ok 10, $+ eq 'a', $+;
  78.  
  79. # $"
  80. @a = qw(foo bar baz);
  81. ok 11, "@a" eq "foo bar baz", "@a";
  82. {
  83.     local $" = ',';
  84.     ok 12, "@a" eq "foo,bar,baz", "@a";
  85. }
  86.  
  87. # $;
  88. %h = ();
  89. $h{'foo', 'bar'} = 1;
  90. ok 13, (keys %h)[0] eq "foo\034bar", (keys %h)[0];
  91. {
  92.     local $; = 'x';
  93.     %h = ();
  94.     $h{'foo', 'bar'} = 1;
  95.     ok 14, (keys %h)[0] eq 'fooxbar', (keys %h)[0];
  96. }
  97.  
  98. # $?, $@, $$
  99. system qq[$PERL -e "exit(0)"];
  100. ok 15, $? == 0, $?;
  101. system qq[$PERL -e "exit(1)"];
  102. ok 16, $? != 0, $?;
  103.  
  104. eval { die "foo\n" };
  105. ok 17, $@ eq "foo\n", $@;
  106.  
  107. ok 18, $$ > 0, $$;
  108.  
  109. # $^X and $0
  110. {
  111.     if ($^O eq 'qnx') {
  112.     chomp($wd = `/usr/bin/fullpath -t`);
  113.     }
  114.     else {
  115.     $wd = '.';
  116.     }
  117.     my $perl = "$wd/perl";
  118.     my $headmaybe = '';
  119.     my $tailmaybe = '';
  120.     $script = "$wd/show-shebang";
  121.     if ($Is_MSWin32) {
  122.     chomp($wd = `cd`);
  123.     $perl = "$wd\\perl.exe";
  124.     $script = "$wd\\show-shebang.bat";
  125.     $headmaybe = <<EOH ;
  126. \@rem ='
  127. \@echo off
  128. $perl -x \%0
  129. goto endofperl
  130. \@rem ';
  131. EOH
  132.     $tailmaybe = <<EOT ;
  133.  
  134. __END__
  135. :endofperl
  136. EOT
  137.     }
  138.     $s1 = $s2 = "\$^X is $perl, \$0 is $script\n";
  139.     ok 19, open(SCRIPT, ">$script"), $!;
  140.     ok 20, print(SCRIPT $headmaybe . <<EOB . <<'EOF' . $tailmaybe), $!;
  141. #!$wd/perl
  142. EOB
  143. print "\$^X is $^X, \$0 is $0\n";
  144. EOF
  145.     ok 21, close(SCRIPT), $!;
  146.     ok 22, chmod(0755, $script), $!;
  147.     $_ = `$script`;
  148.     s/.exe//i if $Is_Dos;
  149.     s{\bminiperl\b}{perl}; # so that test doesn't fail with miniperl
  150.     s{is perl}{is $perl}; # for systems where $^X is only a basename
  151.     ok 23, ($Is_MSWin32 ? uc($_) eq uc($s2) : $_ eq $s2), ":$_:!=:$s2:";
  152.     $_ = `$perl $script`;
  153.     s/.exe//i if $Is_Dos;
  154.     ok 24, ($Is_MSWin32 ? uc($_) eq uc($s1) : $_ eq $s1), ":$_:!=:$s1: after `$perl $script`";
  155.     ok 25, unlink($script), $!;
  156. }
  157.  
  158. # $], $^O, $^T
  159. ok 26, $] >= 5.00319, $];
  160. ok 27, $^O;
  161. ok 28, $^T > 850000000, $^T;
  162.  
  163. if ($Is_VMS || $Is_Dos) {
  164.     ok "29 # skipped", 1;
  165.     ok "30 # skipped", 1;
  166. }
  167. else {
  168.     $PATH = $ENV{PATH};
  169.     $ENV{foo} = "bar";
  170.     %ENV = ();
  171.     $ENV{PATH} = $PATH;
  172.     ok 29, ($Is_MSWin32 ? (`cmd /x /c set foo 2>NUL` eq "")
  173.                 : (`echo \$foo` eq "\n") );
  174.  
  175.     $ENV{NoNeSuCh} = "foo";
  176.     $0 = "bar";
  177.     ok 30, ($Is_MSWin32 ? (`cmd /x /c set NoNeSuCh` eq "NoNeSuCh=foo\n")
  178.                         : (`echo \$NoNeSuCh` eq "foo\n") );
  179. }
  180.  
  181. {
  182.     local $SIG{'__WARN__'} = sub { print "not " };
  183.     $! = undef;
  184.     print "ok 31\n";
  185. }
  186.  
  187. # test case-insignificance of %ENV (these tests must be enabled only
  188. # when perl is compiled with -DENV_IS_CASELESS)
  189. if ($Is_MSWin32) {
  190.     %ENV = ();
  191.     $ENV{'Foo'} = 'bar';
  192.     $ENV{'fOo'} = 'baz';
  193.     ok 32, (scalar(keys(%ENV)) == 1);
  194.     ok 33, exists($ENV{'FOo'});
  195.     ok 34, (delete($ENV{'foO'}) eq 'baz');
  196.     ok 35, (scalar(keys(%ENV)) == 0);
  197. }
  198. else {
  199.     ok "32 # skipped",1;
  200.     ok "33 # skipped",1;
  201.     ok "34 # skipped",1;
  202.     ok "35 # skipped",1;
  203. }
  204.